home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / NEWS / BOOTSTRAP / BOOTSTRAP2 < prev    next >
Text File  |  1991-11-17  |  8KB  |  278 lines
  1. Article 82 of comp.binaries.acorn:
  2. Path: rusmv1!Sirius.dfn.de!darwin.sura.net!europa.asd.contel.com!uunet!mcsun!uknet!acorn!cmarshall
  3. From: cmarshall@acorn.co.uk (Chris Marshall)
  4. Newsgroups: comp.binaries.acorn
  5. Subject: v03INF2:  Bootstrap, part 2 of 5
  6. Message-ID: <11036@acorn.co.uk>
  7. Date: 13 Nov 91 14:20:15 GMT
  8. Sender: cmarshal@acorn.co.uk
  9. Distribution: comp
  10. Organization: Acorn Computers Ltd, Cambridge, England
  11. Lines: 262
  12. Approved: cmarshall@acorn.co.uk
  13.  
  14. Posting-number: Volume 03, Info 02
  15. Submitted-by: Alan Glover <aglover@acorn.co.uk>
  16. Archive-name: bootstrap/part02
  17.  
  18. This is the second of five postings which will culminate with you having a
  19. usable copy of !Extract (a tool to extract multi part postings) and
  20. !SubExtWrk (a working directory for !Extract and it's counterpart !Submit).
  21.  
  22. Save the data below under the name "Bark". When the need arises to run it
  23. (as detailed in subsequent articles), the command to do so is  *BASIC Bark
  24.  
  25. --- CUT ---
  26.  
  27.    10REM>Bark
  28.    20REM This program will unpack Spark or arc style archives on the BBC
  29.    30REM and Archimedes. To produce an archive that can be unpacked using it
  30.    40REM you must set arc or Spark to not use squashing.
  31.    50REM Although you can use this on the Archie, a much better solution,
  32.    60REM is to use !SparkPlug. If you have an Archie, and would like to make
  33.    70REM your own archives and manipulate them in style from the desktop,
  34.    80REM you need a copy of Spark. This is obtainable for M-#5.99 from:
  35.    90REM David Pilling,
  36.   100REM P.O. Box 22,
  37.   110REM Thornton Cleveleys,
  38.   120REM Blackpool.
  39.   130REM FY5 1LR.
  40.   140REM
  41.   150REM You are encouraged to add your own bits to this program and pass it on.
  42.   160REM If you do modify it, add your name and details below.
  43.   170REM
  44.   180REM V0.00 20th September 1989 -- David Pilling
  45.   190REM V0.01 25th September 1989 -- Philip Colmer
  46.   200REM                              Changed BASIC V usage to BASIC II
  47.   210REM V0.02 21st February 1990  -- Philip Colmer
  48.   220REM                              Improved support for DFS
  49.   230REM V0.03 22nd April 1991     -- Philip Colmer
  50.   240REM                              Fixed bugs in directory handling
  51.   250REM
  52.   260REM
  53.   270:
  54.   290*CLOSE
  55.   300:
  56.   310PRINT"Bark V0.03 April 1991"
  57.   320INPUT"Enter name of file to decode:"N$:IFN$="" END
  58.   330:
  59.   340Y%=0:X%=OPENIN(N$)
  60.   350IFX%=0 PROCABEND("Can't open input file")
  61.   360:
  62.   370DIM FIX 4
  63.   380DIM suffix  4096
  64.   390DIM prefix1 4096
  65.   400DIM prefix2 4096
  66.   410DIM stack   4096
  67.   420DIM buf     128
  68.   430DIM stamp   18
  69.   440DIM name    256
  70.   450:
  71.   460DIM rmask 9
  72.   470rmask?0=0
  73.   480rmask?1=1
  74.   490rmask?2=3
  75.   500rmask?3=7
  76.   510rmask?4=15
  77.   520rmask?5=31
  78.   530rmask?6=63
  79.   540rmask?7=127
  80.   550rmask?8=255
  81.   560:
  82.   570R$=""
  83.   580level%=0
  84.   590DIM L%(32)
  85.   600L%(level%)=0
  86.   610over%=FALSE
  87.   620REPEAT
  88.   630PROCRDHDR
  89.   640IF earc% AND level%=0 CLOSE#X%:END
  90.   650IF over% CLOSE#X%:END
  91.   660IF isdir PROCDIR ELSEIFearc% PROCENDDIR ELSE PROCUNPACK
  92.   670UNTIL EOF#X% OR over%
  93.   680END
  94.   690:
  95.   700DEFPROCABEND(E$)
  96.   710PRINT"Bark has abended because:",E$
  97.   720IFX%<>0 CLOSE#X%
  98.   730IFY%<>0 CLOSE#Y%
  99.   740END
  100.   750ENDPROC
  101.   760:
  102.   770DEFFNword
  103.   780FIX?0=BGET#X%
  104.   790FIX?1=BGET#X%
  105.   800FIX?2=BGET#X%
  106.   810FIX?3=BGET#X%
  107.   820:=!FIX
  108.   830:
  109.   840DEFFNdble
  110.   850I%=BGET#X%
  111.   860I%=I%+&100*BGET#X%
  112.   870:=I%
  113.   880:
  114.   890DEFPROCRDHDR
  115.   900I%=BGET#X%
  116.   910IF I%<>26 PRINT"Bad Header in:"N$:REPEAT I%=BGET#X%:UNTIL I%=26 OR EOF#X%:IF EOF#X%:over%=TRUE:ENDPROC
  117.   920type%=BGET#X% AND &7F
  118.   930IF type%=0 earc%=TRUE:isdir=FALSE:ENDPROC ELSE earc%=FALSE
  119.   940F$="":T%=TRUE
  120.   950FOR I%=1 TO 13
  121.   960J%=BGET#X%
  122.   970IF J%>32 AND T%:F$=F$+CHR$J% ELSE T%=FALSE
  123.   980NEXT
  124.   990clen%=FNword
  125.  1000date%=FNdble
  126.  1010time%=FNdble
  127.  1020crc%=FNdble
  128.  1030IF type%>1 olen%=FNword ELSE olen%=clen%
  129.  1040load%=FNword
  130.  1050exec%=FNword
  131.  1060attr%=FNword
  132.  1070IF type%=2 AND FNTYPE=&DDC isdir=TRUE ELSE isdir=FALSE
  133.  1080ENDPROC
  134.  1090:
  135.  1100DEFFNTYPE
  136.  1110IF((load% AND &FFF00000)=&FFF00000) :=(load% AND &FFF00)/256 ELSE :=-1
  137.  1120:
  138.  1130DEFPROCDIR
  139.  1140L%(level%)=LENR$
  140.  1150IF LENR$>0 R$=R$+F$ ELSE R$=F$
  141.  1160level%=level%+1
  142.  1170S$="CDIR "+R$
  143.  1180R$=R$+"."
  144.  1190PRINT"Creating directory",R$
  145.  1200REM filing systems which allow directories are
  146.  1201REM ADFS (8)
  147.  1202REM Econet (5)
  148.  1203REM SCSI (26)
  149.  1210IFFNfs=8 ORFNfs=5 OR FNfs=26 OSCLI(S$)
  150.  1220ENDPROC
  151.  1230:
  152.  1240DEFPROCENDDIR
  153.  1250level%=level%-1
  154.  1260R$=LEFT$(R$,L%(level%))
  155.  1270IFR$<>"" PRINT"Directory:     ",R$
  156.  1280ENDPROC
  157.  1290:
  158.  1300DEFPROCUNPACK
  159.  1310PRINT"Restoring file:",R$+F$
  160.  1320Y%=OPENOUT(R$+F$)
  161.  1330IF type%=1 OR type%=2 PROCUNSTORE ELSE IF type%=8 PROCUNCRUNCH ELSE IF type%=3 PROCUNPCK ELSE PROCABEND("Can't unpack "+F$)
  162.  1340CLOSE#Y%:Y%=0
  163.  1350PROCSTAMP
  164.  1360ENDPROC
  165.  1370:
  166.  1380DEFPROCUNSTORE
  167.  1390PRINT"Unstoring"
  168.  1400FOR I%=1 TO clen%
  169.  1410BPUT#Y%,BGET#X%
  170.  1420NEXT
  171.  1430ENDPROC
  172.  1440:
  173.  1450DEFPROCUNPCK
  174.  1460PRINT"Unpacking"
  175.  1470L%=0:C%=0
  176.  1480FOR I%=1 TO clen%
  177.  1490PROCputc_ncr(BGET#X%)
  178.  1500NEXT
  179.  1510ENDPROC
  180.  1520:
  181.  1530DEFFNMAXCODE(n)=2^n-1
  182.  1540:
  183.  1550DEFPROCputc_ncr(B%)
  184.  1560IF C%=1 ELSE 1580
  185.  1570IF B%=0:BPUT#Y%,&90:C%=0:ENDPROC ELSE FOR K%=2 TO B%:BPUT#Y%,L%:NEXT:C%=0:ENDPROC
  186.  1580IFB%=&90 C%=1:ENDPROC
  187.  1590L%=B%:BPUT#Y%,L%
  188.  1600ENDPROC
  189.  1610:
  190.  1620DEFPROCUNCRUNCH
  191.  1630PRINT"Uncrunching"
  192.  1640C%=0
  193.  1650offset=0:size=0:R%=clen%
  194.  1660code=FNGETC
  195.  1670IF code<>12 PROCABEND("File packed with illegal number of bits")
  196.  1680n_bits=9
  197.  1690clear_flg=0
  198.  1700maxcode=FNMAXCODE(n_bits)
  199.  1710FOR I%=0 TO 256:prefix1?I%=0:prefix2?I%=0:NEXT
  200.  1720FOR code=0 TO 255:suffix?code=code:NEXT
  201.  1730free_ent=257
  202.  1740oldcode=FNgetcode:finchar=oldcode
  203.  1750IF oldcode=-1 ENDPROC
  204.  1760PROCputc_ncr(finchar)
  205.  1770stackp=stack
  206.  1780code=FNgetcode
  207.  1790IF code<0 ENDPROC
  208.  1800IF code=256:FOR I%=0 TO 256:prefix1?I%=0:prefix2?I%=0:NEXT:clear_flg=1:free_ent=256:code=FNgetcode:IF code=-1 ENDPROC
  209.  1810incode = code
  210.  1820IF code>=free_ent ?stackp=finchar:stackp=stackp+1:code=oldcode
  211.  1830IF code>=256 ELSE 1870
  212.  1840?stackp=suffix?code:stackp=stackp+1
  213.  1850code=prefix1?code+256*prefix2?code
  214.  1860GOTO 1830
  215.  1870finchar=suffix?code:?stackp=finchar:stackp=stackp+1
  216.  1880REPEAT
  217.  1890stackp=stackp-1:PROCputc_ncr(?stackp)
  218.  1900UNTIL stackp=stack
  219.  1910code=free_ent
  220.  1920IF code < 4096 ELSE 1970
  221.  1930prefix1?code=oldcode
  222.  1940prefix2?code=oldcode/256
  223.  1950suffix?code=finchar
  224.  1960free_ent=code+1
  225.  1970oldcode=incode
  226.  1980GOTO 1780
  227.  1990ENDPROC
  228.  2000:
  229.  2010DEFFNGETC
  230.  2020IF R%>0 R%=R%-1:=BGET#X% ELSE :=-1
  231.  2030:
  232.  2040DEFFNgetcode
  233.  2050LOCAL code
  234.  2060bp=buf
  235.  2070IF clear_flg>0 OR offset>=size OR free_ent>maxcode ELSE 2180
  236.  2080IF free_ent > maxcode ELSE 2110
  237.  2090n_bits=n_bits+1
  238.  2100IF n_bits=12 maxcode = 4096 ELSE maxcode=FNMAXCODE(n_bits)
  239.  2110IF clear_flg>0 n_bits=9:maxcode=FNMAXCODE(n_bits):clear_flg=0
  240.  2120FOR size=0 TO n_bits-1
  241.  2130code=FNGETC
  242.  2140IF code=-1 temp=size:size=n_bits:NEXT ELSE buf?size=code:NEXT
  243.  2150IF size=n_bits+1:size=temp:IF size<=0:=-1
  244.  2160offset=0
  245.  2170size=(size*8)-(n_bits-1)
  246.  2180r_off=offset
  247.  2190bits=n_bits
  248.  2200bp=bp+r_off/8
  249.  2210r_off=r_off AND 7
  250.  2220code=(?bp/(2^r_off)):bp=bp+1
  251.  2230bits=bits-(8-r_off)
  252.  2240r_off=8-r_off
  253.  2250IF bits>=8 ELSE 2290
  254.  2260code=code OR (?bp*(2^r_off)):bp=bp+1
  255.  2270r_off=r_off+8
  256.  2280bits=bits-8
  257.  2290code=code OR ((?bp AND rmask?bits)*(2^r_off))
  258.  2300offset=offset+n_bits
  259.  2310:=code AND 4095
  260.  2320:
  261.  2330DEFPROCSTAMP
  262.  2340REM modified by Philip Colmer so that it doesn't try to do
  263.  2350REM SYS"OS_File"
  264.  2360LOCAL A%,X%,Y%
  265.  2370!stamp=name
  266.  2380stamp!2=load%
  267.  2390stamp!6=exec%
  268.  2400stamp!14=attr%
  269.  2410$name=R$+F$
  270.  2420A%=1:X%=stamp MOD256:Y%=stamp DIV256:CALL &FFDD
  271.  2430ENDPROC
  272.  2440:
  273.  2450DEFFNfs
  274.  2460A%=0:Y%=0
  275.  2470=USR&FFDA AND &FF
  276.  
  277.  
  278.